home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
UTILITY
/
TSRSRC34.ARJ
/
MAPMEM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-14
|
31KB
|
1,032 lines
{**************************************************************************
* MAPMEM - Reports system memory blocks. *
* Copyright (c) 1986,1991 Kim Kokkonen, TurboPower Software. *
* May be freely distributed and used but not sold except by permission. *
***************************************************************************
* version 1.0 1/2/86 *
* : *
* long intervening history *
* : *
* version 3.0 9/24/91 *
* completely rewritten for DOS 5 compatibility *
* add upper memory reporting *
* add XMS reporting *
* add free memory report *
* report on EMS handle names *
* change command line switches *
* add check for TSR feature *
* add Quiet option (useful with "check for" option only) *
* add summary report *
* version 3.1 11/4/91 *
* fix bug in EMS handle reporting *
* fix problem in getting name of TSR that shrinks environment (FSP) *
* prevent from keeping interrupt 0 *
* fix source naming of WriteChained vs WriteHooked *
* show command line and vectors even if lower part of PSP is *
* overwritten (DATAPATH) *
* wouldn't find (using /C) a program whose name was stored in *
* lowercase in the environment (Windows 3.0) *
* version 3.2 11/22/91 *
* generalize high memory support *
* handle some DRDOS 6.0 conventions *
* fix indentation problem in raw extended memory report *
* version 3.3 1/8/92 *
* /C getname wasn't finding TSRs in high memory *
* increase stack space *
* new features for parsing and getting command line options *
* version 3.4 2/14/92 *
* fix bug in memory reported for device memory blocks *
* add /L option to turn off low memory reporting *
* change /C to find TSRS only in low memory unless /U specified *
* add a new test to validate command line strings of mcbs *
***************************************************************************
* telephone: 719-260-6641, CompuServe: 76004,2611. *
* requires Turbo Pascal 6 to compile. *
***************************************************************************}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 4096,2048,655360}
{.$DEFINE MeasureStack} {Activate to measure stack usage}
program MapMem;
uses
Dos,
MemU,
Xms,
Ems;
const
CheckTSR : Boolean = False; {'C'}
ShowEmsMem : Boolean = False; {'E'}
ShowFree : Boolean = False; {'F'}
UseWatch : Boolean = True; {'H'}
UseLoMem : Boolean = True; {'L'}
Quiet : Boolean = False; {'Q'}
ShowSummary : Boolean = False; {'S'}
UseHiMem : Boolean = False; {'U'}
Verbose : Boolean = False; {'V'}
ShowExtMem : Boolean = False; {'X'}
var
TotalMem : LongInt;
TopSeg : Word;
HiMemSeg : Word;
WatchPsp : Word;
ShowDevices : Boolean;
ShowSegments : Boolean;
ShowBlocks : Boolean;
ShowFiles : Boolean;
ShowVectors : Boolean;
GotXms : Boolean;
SizeLen : Byte;
NameLen : Byte;
CmdLen : Byte;
UmbLinkStatus : Boolean;
SaveExit : Pointer;
TsrName : string[79];
{$IFDEF MeasureStack}
I : Word;
{$ENDIF}
const
FreeName : string[10] = '---free---';
TotalName : string[10] = '---total--';
const
VerboseIndent = 5;
NoShowVecSeg = $FFFE;
ShowVecSeg = $FFFF;
procedure SafeExit; far;
begin
ExitProc := SaveExit;
SwapVectors;
end;
function GetName(M : McbPtr; var Devices : Boolean) : String;
{-Return a name for Mcb M}
const
EnvName : array[boolean] of string[4] = ('', 'env');
DatName : array[boolean] of string[4] = ('', 'data');
var
PspSeg : Word;
IsCmd : Boolean;
begin
Devices := False;
PspSeg := M^.Psp;
if (PspSeg = 0) or (PspSeg = PrefixSeg) then
GetName := FreeName
else if PspSeg = 8 then begin
GetName := 'sys data';
if DosV = 5 then
if (M^.Name[1] = 'S') and (M^.Name[2] = 'D') then begin
GetName := 'cfg info';
Devices := True;
end;
end else if (PspSeg < 8) or (PspSeg >= $FFF0) then
GetName := 'unknown'
else if PspSeg = OS(M).S+1 then begin
{program block}
IsCmd := (PspSeg = MemW[PspSeg:$16]);
if (not IsCmd) and (DosV > 2) and HasEnvironment(HiMemSeg, M) then
GetName := NameFromEnv(M)
else if DosV >= 4 then
GetName := NameFromMcb(M)
else if IsCmd then
GetName := 'command'
else if DosVT >= $031E then
GetName := NameFromMcb(M)
else
GetName := 'n/a';
end else if MemW[PspSeg:$2C] = OS(M).S+1 then
GetName := EnvName[Verbose]+'('+GetName(Ptr(PspSeg-1, 0), Devices)+')'
else
GetName := DatName[Verbose]+'('+GetName(Ptr(PspSeg-1, 0), Devices)+')';
end;
function ValidPsp(PspSeg : Word) : Boolean;
{-Return True if PspSeg is a valid Psp}
begin
if ((PspSeg >= 0) and (PspSeg <= 8)) or
(PspSeg = PrefixSeg) or
(PspSeg >= $FFF0) then
ValidPsp := False
else
ValidPsp := True;
end;
function GetFiles(M : McbPtr) : Word;
{-Return number of open files for given Mcb's Psp}
type
HandleTable = array[0..65520] of Byte;
var
PspSeg : Word;
O : Word;
Files : Word;
FileMax : Word;
TablePtr : ^HandleTable;
begin
PspSeg := M^.Psp;
if (PspSeg <> OS(M).S+1) or not ValidPsp(PspSeg) or
(MemW[PspSeg:$50] <> $21CD) then begin
GetFiles := 0;
Exit;
end;
{Deal with expanded handle tables in DOS 3.0 and later}
if DosV >= 3 then begin
FileMax := MemW[M^.Psp:$32];
TablePtr := Pointer(MemL[M^.Psp:$34]);
end else begin
FileMax := 20;
TablePtr := Ptr(M^.Psp, $18);
end;
Files := 0;
for O := 0 to FileMax-1 do
case TablePtr^[O] of
0, 1, 2, $FF : {standard handle or not open} ;
else
Inc(Files);
end;
GetFiles := Files;
end;
function GetCmdLine(M : McbPtr) : String;
{-Return command line for program}
var
PspSeg : Word;
Len : Byte;
S : String[127];
begin
PspSeg := M^.Psp;
if (PspSeg <> OS(M).S+1) or not ValidPsp(PspSeg) then begin
GetCmdLine := '';
Exit;
end;
Move(Mem[PspSeg:$80], S, 127);
if S <> '' then begin
Len := Length(S);
if (Len > 127) or (S[Len+1] <> ^M) then
S := ''
else
StripNonAscii(S);
if S = '' then
S := 'n/a';
end;
while (Length(S) > 0) and (S[1] = ' ') do
Delete(S, 1, 1);
GetCmdLine := S;
end;
procedure WriteHooked(LowSeg, HighSeg : Word; StartCol, WrapCol : Byte);
{-Write vectors that point into specified region of memory}
var
Vectors : array[0..255] of Pointer absolute 0:0;
Vec : Pointer;
LoL : LongInt;
HiL : LongInt;
VeL : LongInt;
V : Byte;
Col : Byte;
begin
LoL := LongInt(LowSeg) shl 4;
HiL := LongInt(HighSeg) shl 4;
Col := StartCol;
for V := 0 to 255 do begin
Vec := Vectors[V];
VeL := (LongInt(OS(Vec).S) shl 4)+OS(Vec).O;
if (VeL >= LoL) and (VeL < HiL) then begin
if Col+3 > WrapCol then begin
{wrap to next line}
Write(^M^J, '':StartCol-1);
Col := StartCol;
end;
Write(HexB(V), ' ');
inc(Col, 3);
end;
end;
end;
procedure WriteChained(PspSeg : Word; StartCol, WrapCol : Byte);
{-Write vectors that WATCH found taken over by a block}
var
P : ^ChangeBlock;
I, MaxChg, Col : Word;
Found : Boolean;
begin
{initialize}
MaxChg := MemW[WatchPsp:NextChange];
Col := StartCol;
Found := False;
I := 0;
while I < MaxChg do begin
P := Ptr(WatchPsp, ChangeVectors+I);
with P^ do
case ID of
$00 : {ChangeBlock describes an active vector takeover}
if Found then begin
if Col+3 > WrapCol then begin
{wrap to next line}
Write(^M^J, '':StartCol-1);
Col := StartCol;
end;
Write(HexB(Lo(VecNum)), ' ');
inc(Col, 3);
end;
$01 : {ChangeBlock specifies a disabled takeover}
if Found then begin
Write('disabled');
{Don't write this more than once}
Exit;
end;
$FF : {ChangeBlock starts a new PSP}
Found := (PspSeg = PspAdd);
end;
inc(I, SizeOf(ChangeBlock));
end;
end;
procedure WriteVectors(LowSeg, HighSeg : Word; StartCol, WrapCol : Byte);
{-Write interrupt vectors either hooked or chained}
begin
if UseWatch then
WriteChained(LowSeg, StartCol, WrapCol)
else
WriteHooked(LowSeg, HighSeg, StartCol, WrapCol);
end;
procedure WriteMcb(McbSeg, PspSeg, Paras, Blocks, Files : Word;
Name : String; CmdLine : String);
{-Write information about one Mcb or group of mcbs}
var
Col : Byte;
begin
Col := 1;
if ShowSegments then begin
case McbSeg of
NoShowVecSeg, ShowVecSeg : ;
else
Write(HexW(McbSeg), ' ');
inc(Col, 5);
end;
if (PspSeg = 0) or (PspSeg = 8) then
Write(' ')
else
Write(HexW(PspSeg));
inc(Col, 4);
end else
Write(' ');
if ShowBlocks then begin
Write(' ', Blocks:2);
inc(Col, 3);
end;
if ShowFiles then begin
if Files = 0 then
Write(' ')
else
Write(' ', Files:2);
inc(Col, 3);
end;
Write(' ', CommaIze(LongInt(Paras) shl 4, SizeLen),
' ', Extend(Name, NameLen),
' ', SmartExtend(CmdLine, CmdLen));
inc(Col, 3+SizeLen+NameLen+CmdLen);
if ShowVectors then
if (PspSeg = McbSeg+1) or (McbSeg = ShowVecSeg) then
if ValidPsp(PspSeg) then begin
Write(' ');
WriteVectors(PspSeg, PspSeg+Paras, Col+1, 79);
end;
WriteLn;
{keep track of total reported memory}
Inc(TotalMem, Paras);
Inc(TotalMem, Blocks); {for the mcbs themselves}
end;
procedure WriteDevices(DevSeg, NextSeg : Word);
{-Write the DOS 5 device list}
var
D : McbPtr;
Name : String[79];
begin
D := Ptr(DevSeg, 0);
while OS(D).S < NextSeg do begin
case D^.Id of
'B' : Name := 'buffers';
'C' : Name := 'ems buffers';
'D' : Name := 'device='+Asc2Str(D^.Name);
'E' : Name := 'device ext';
'F' : Name := 'files';
'I' : Name := 'ifs='+Asc2Str(D^.Name);
'L' : Name := 'lastdrive';
'S' : Name := 'stacks';
'X' : Name := 'fcbs';
else
Name := '';
end;
if Name <> '' then
WriteLn('':20, CommaIze(LongInt(D^.Len+1) shl 4, 6), ' ', Name);
D := Ptr(OS(D).S+D^.Len+1, 0);
end;
end;
procedure WriteTotalMem;
{-Write total reported memory with leading space PreSpace}
var
PreSpace : Word;
begin
if TotalMem <> 0 then begin
PreSpace := 7;
if Verbose then
inc(PreSpace, VerboseIndent);
WriteLn('':PreSpace, CommaIze(LongInt(TotalMem) shl 4, 8), ' ', TotalName);
TotalMem := 0;
end;
end;
procedure FindTSR;
{-Find TSRName, report if appropriate, and halt}
procedure FindOne(Start : McbPtr);
var
M : McbPtr;
PspSeg : Word;
Done : Boolean;
IsCmd : Boolean;
Name : String[79];
begin
M := Start;
repeat
PspSeg := M^.Psp;
if OS(M).S+1 = PspSeg then begin
IsCmd := (PspSeg = MemW[PspSeg:$16]);
if (not IsCmd) and (DosV > 2) and HasEnvironment(HiMemSeg, M) then
Name := NameFromEnv(M)
else if DosV >= 4 then
Name := NameFromMcb(M)
else if (not IsCmd) and (DosVT >= $031E) then
Name := NameFromMcb(M)
else
Name := '';
if StUpcase(Name) = TsrName then begin
if not Quiet then
WriteLn('Found ', TsrName, ' at ', HexW(PspSeg));
Halt(0);
end;
end;
Done := (M^.Id = 'Z');
M := Ptr(OS(M).S+M^.Len+1, 0);
until Done;
end;
begin
if UseLoMem then
FindOne(Mcb1);
if UseHiMem then
FindOne(Ptr(HiMemSeg, 0));
{Not found if we get here}
if not Quiet then
WriteLn('Did not find ', TsrName);
Halt(2);
end;
procedure ShowChain(M : McbPtr);
{-Show chain of blocks starting at M}
var
Done : Boolean;
begin
repeat
WriteMcb(OS(M).S, M^.Psp, M^.Len, 1,
GetFiles(M), GetName(M, ShowDevices), GetCmdLine(M));
if ShowDevices then
WriteDevices(OS(M).S+1, OS(M).S+M^.Len+1);
Done := (M^.Id = 'Z');
M := Ptr(OS(M).S+M^.Len+1, 0);
until Done;
WriteTotalMem;
end;
procedure WriteVerbose;
{-Report on each Mcb individually}
var
M : McbPtr;
begin
Write('Mcb Psp Hdl Size Name Command Line ');
if UseWatch then
Write('Chained')
else
Write('Hooked');
WriteLn(' Vectors');
WriteLn('---- ---- --- ------ -------------- ------------------- -----------------------');
if UseLoMem then begin
{fake Mcb's used by dos itself}
WriteMcb($0000, $0000, $0040, 0, 0, 'vectors', '');
WriteMcb($0040, $0000, $0010, 0, 0, 'BIOS data', '');
WriteMcb($0050, $0000, $0020, 0, 0, 'DOS data', '');
WriteMcb($0070, $0000, OS(DosList).S-$70, 0, 0, 'sys data', '');
WriteMcb(OS(DosList).S, $0000, OS(Mcb1).S-OS(DosList).S, 0, 0, 'sys code', '');
M := Mcb1;
ShowChain(Mcb1);
end;
if UseHiMem then begin
if UseLoMem then
WriteLn(^M^J'High Memory');
ShowChain(Ptr(HiMemSeg, 0));
end;
end;
procedure SummarizePsp(TPsp, LoMcb, HiMcb : Word);
{-Write info about all Mcbs in range LoMcb..HiMcb with the specified Psp}
var
TM : McbPtr;
M : McbPtr;
Size : Word;
Blocks : Word;
FakeSeg : Word;
MPsp : Word;
Done : Boolean;
HaveCodeBlock : Boolean;
begin
Size := 0;
Blocks := 0;
M := Ptr(LoMcb, 0);
TM := nil;
HaveCodeBlock := False;
repeat
MPsp := M^.Psp;
if MPsp = 0 then
MPsp := OS(M).S;
if MPsp = TPsp then begin
if (OS(M).S >= LoMcb) and (OS(M).S < HiMcb) then begin
Inc(Size, M^.Len);
Inc(Blocks);
if OS(M).S+1 = TPsp then
HaveCodeBlock := True;
end;
if TM = nil then
TM := M
else if M^.Psp = OS(M).S+1 then
TM := M;
end;
Done := (M^.Id = 'Z');
M := Ptr(OS(M).S+M^.Len+1, 0);
until Done;
if Blocks > 0 then begin
if HaveCodeBlock then
FakeSeg := ShowVecSeg
else
FakeSeg := NoShowVecSeg;
WriteMcb(FakeSeg, TM^.Psp, Size, Blocks, 0,
GetName(TM, ShowDevices), GetCmdLine(TM));
end;
end;
procedure SummarizeRange(LoMcb, HiMcb : Word);
{-Summarize Psps in the range LoMcb..HiMcb,
for Psp > 8, Psp < $FFF0, and Psp <> PrefixSeg}
var
M : McbPtr;
MinPsp : Word;
TPsp : Word;
PrvPsp : Word;
Done : Boolean;
begin
PrvPsp := 8;
repeat
{find the smallest Psp not yet summarized}
MinPsp := $FFFF;
M := Ptr(LoMcb, 0);
repeat
TPsp := M^.Psp;
if TPsp = 0 then
TPsp := OS(M).S;
if TPsp < MinPsp then
if (TPsp > PrvPsp) and (TPsp < $FFF0) and (TPsp <> PrefixSeg) then
MinPsp := TPsp;
Done := (M^.Id = 'Z');
M := Ptr(OS(M).S+M^.Len+1, 0);
until Done;
if MinPsp <> $FFFF then begin
{add up info about this Psp}
SummarizePsp(MinPsp, LoMcb, HiMcb);
{"mark out" this Psp}
PrvPsp := MinPsp;
end;
until MinPsp = $FFFF;
end;
procedure SummarizeDos(LoMcb, HiMcb : Word);
{-Sum up memory attributed to DOS}
var
M : McbPtr;
Size : Word;
Blocks : Word;
FakeSeg : Word;
Done : Boolean;
begin
M := Ptr(LoMcb, 0);
Size := 0;
Blocks := 0;
repeat
if M^.Psp = 8 then
if (OS(M).S >= LoMcb) and (OS(M).S < HiMcb) then begin
Inc(Size, M^.Len);
Inc(Blocks);
end;
Done := (M^.Id = 'Z');
M := Ptr(OS(M).S+M^.Len+1, 0);
until Done;
if Blocks > 0 then begin
if HiMcb > TopSeg then
FakeSeg := NoShowVecSeg
else
FakeSeg := ShowVecSeg;
WriteMcb(FakeSeg, $00, OS(Mcb1).S+Size, Blocks, 0, 'DOS', '');
end;
end;
procedure SummarizeFree(LoMcb, HiMcb : Word);
{-Write the free memory blocks in specified range of Mcbs}
var
M : McbPtr;
Done : Boolean;
begin
M := Ptr(LoMcb, 0); {!!}
{M := Mcb1;} {!!}
repeat
if (M^.Psp = 0) and (M^.Len > 0) and
(OS(M).S >= LoMcb) and (OS(M).S < HiMcb) then
WriteMcb(NoShowVecSeg, $0000, M^.Len, 1, 0, FreeName, '');
Done := (M^.Id = 'Z');
M := Ptr(OS(M).S+M^.Len+1, 0);
until Done;
end;
procedure WriteCondensed;
{-Report on Mcb's by Psp}
begin
Write('Psp Cnt Size Name Command Line ');
if UseWatch then
Write('Chained')
else
Write('Hooked');
WriteLn(' Vectors');
WriteLn('---- --- ------ ---------- ------------------- --------------------------------');
if UseLoMem then begin
SummarizeDos(OS(Mcb1).S, TopSeg-1); {DOS memory usage}
SummarizeRange(OS(Mcb1).S, TopSeg-1);{programs loaded in low memory}
SummarizePsp(PrefixSeg, OS(Mcb1).S, $FFFF); {current program free space}
WriteTotalMem; {sum of memory so far}
end;
if UseHiMem then begin
if UseLoMem then
WriteLn(^M^J'High Memory');
SummarizeDos(HiMemSeg, $FFFF);
SummarizeRange(HiMemSeg, $FFFF);
WriteTotalMem;
end;
end;
procedure WriteFree;
{-Show just the free blocks in conventional memory}
begin
if UseLoMem then begin
WriteLn('Normal Memory');
SummarizeFree(OS(Mcb1).S, TopSeg-1); {free blocks in low memory}
SummarizePsp(PrefixSeg, OS(Mcb1).S, $FFFF); {current program free space}
end;
if UseHiMem then begin
if UseLoMem then
WriteLn(^M^J'High Memory');
SummarizeFree(HiMemSeg, $FFFF);
end;
end;
procedure WriteSummary;
{-Write "summary" report for conventional memory}
begin
WriteLn(' Size Name Command Line');
WriteLn('---------- ---------- --------------------------------------------------------');
if UseLoMem then begin
SummarizeDos(OS(Mcb1).S, TopSeg-1); {DOS memory usage}
SummarizeRange(OS(Mcb1).S, TopSeg-1); {programs loaded in low memory}
SummarizePsp(PrefixSeg, OS(Mcb1).S, $FFFF); {current program free space}
end;
if UseHiMem then begin
if UseLoMem then
WriteLn(^M^J'High Memory');
SummarizeDos(HiMemSeg, $FFFF);
SummarizeRange(HiMemSeg, $FFFF);
end;
end;
procedure ShowConventionalMem;
{-Report on conventional memory, low and high}
begin
{Default values for display}
ShowSegments := True;
ShowBlocks := False;
ShowFiles := False;
ShowVectors := True;
SizeLen := 7;
NameLen := 10;
CmdLen := 19;
if ShowFree then begin
ShowSegments := False;
ShowVectors := False;
WriteFree;
end else if ShowSummary then begin
ShowSegments := False;
ShowVectors := False;
CmdLen := 56;
WriteSummary;
end else if Verbose then begin
ShowFiles := True;
NameLen := 14;
WriteVerbose;
end else begin
ShowBlocks := True;
WriteCondensed;
end;
end;
procedure ShowTheEmsMem;
var
Handles : Word;
H : Word;
P : Word;
Pages : LongInt;
EmsV : Byte;
PreSpace : Byte;
Name : string[9];
PageMap : PageArray;
begin
if not EmsPresent then
Exit;
WriteLn;
WriteLn('EMS Memory');
if not(ShowFree or ShowSummary) then begin
EmsV := EmsVersion;
Handles := EmsHandles(PageMap);
if Handles > 0 then
for H := 1 to Handles do begin {!!}
P := PageMap[H].NumPages;
if P <> 0 then begin
Write(HexW(H), ' ');
if Verbose then
Write('':VerboseIndent);
Write(CommaIze(LongInt(P) shl 14, 10));
if EmsV >= $40 then begin
GetHandleName(PageMap[H].Handle, Name);
if Name = '' then
Name := 'n/a';
end else
Name := 'n/a';
WriteLn(' ', Name);
end;
end;
end;
Pages := EmsPagesAvailable;
if ShowFree or ShowSummary then
PreSpace := 0
else
PreSpace := 5;
if Verbose then
inc(PreSpace, VerboseIndent);
WriteLn('':PreSpace, CommaIze(LongInt(OS(Pages).O) shl 14, 10), ' ', FreeName);
if ShowSummary or (not ShowFree) then
WriteLn('':PreSpace, CommaIze(LongInt(OS(Pages).S) shl 14, 10), ' ', TotalName);
end;
procedure ShowTheXmsMem;
{-Show what we can about XMS}
label
ExitPoint;
var
FMem : Word;
FMax : Word;
XHandles : Word;
H : Word;
HMem : Word;
Total : Word;
XmsPages : XmsHandlesPtr;
Status : Byte;
PreSpace : Byte;
begin
if not XmsInstalled then
Exit;
Status := QueryFreeExtMem(FMem, FMax);
if Status = $A0 then begin
FMem := 0;
FMax := 0;
end else if Status <> 0 then
Exit;
{Total will count total XMS memory}
Total := 0;
WriteLn(^M^J'XMS Memory');
GotXms := not Verbose;
if ShowFree then
goto ExitPoint;
{Get an array containing handles}
XHandles := GetXmsHandles(XmsPages);
{Report all the handles}
for H := 1 to XHandles do begin
HMem := XmsPages^[H].NumPages;
if not ShowSummary then begin
Write(HexW(H), ' ');
if Verbose then
Write('':VerboseIndent);
WriteLn(CommaIze(LongInt(HMem) shl 10, 10), ' n/a');
end;
inc(Total, HMem);
end;
{Add the free memory to the total}
inc(Total, FMem);
ExitPoint:
if ShowFree or ShowSummary then
PreSpace := 0
else
PreSpace := 5;
if Verbose then
inc(PreSpace, VerboseIndent);
WriteLn('':PreSpace, CommaIze(LongInt(FMem) shl 10, 10), ' ', FreeName);
if Total <> 0 then
WriteLn('':PreSpace, CommaIze(LongInt(Total) shl 10, 10), ' ', TotalName);
end;
procedure ShowTheExtendedMem;
var
Total : LongInt;
PreSpace : Byte;
begin
if GotXms or ShowFree then
Exit;
if ExtMemPossible then
Total := ExtMemTotalPrim
else
Total := 0;
if Total = 0 then
Exit;
WriteLn(^M^J'Raw Extended Memory');
if ShowSummary then
PreSpace := 0
else
PreSpace := 5;
if Verbose then
inc(PreSpace, VerboseIndent);
WriteLn('':PreSpace, CommaIze(Total, 10), ' ', TotalName);
end;
procedure WriteCopyright;
{-Write a copyright message}
begin
Write('MAPMEM ', Version, ', Copyright 1991 TurboPower Software'^M^J);
end;
procedure Initialize;
{-Initialize various global variables}
begin
GotXms := False;
TotalMem := 0;
TopSeg := TopOfMemSeg;
end;
procedure GetOptions;
{-Parse command line and set options}
var
Arg : String[127];
procedure WriteHelp;
begin
WriteCopyright;
WriteLn;
WriteLn('MAPMEM produces a report showing what memory resident programs are installed,');
WriteLn('how much memory each uses, and what interrupt vectors are taken over.');
WriteLn;
WriteLn('MAPMEM accepts the following command line syntax:');
WriteLn;
WriteLn(' MAPMEM [Options]');
WriteLn;
WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
WriteLn;
WriteLn(' /C name check whether TSR "name" is loaded.');
WriteLn(' /E report expanded (EMS) memory.');
WriteLn(' /F report free areas only.');
WriteLn(' /H do not use WATCH information for vectors.');
WriteLn(' /L do not report low memory blocks (<640K).');
WriteLn(' /Q write no screen output with /C option.');
WriteLn(' /S show summary of all memory areas.');
WriteLn(' /U report upper memory blocks if available.');
WriteLn(' /V verbose report.');
WriteLn(' /X report extended (XMS) memory.');
WriteLn(' /? write this help screen.');
Halt(1);
end;
procedure UnknownOption;
begin
WriteCopyright;
WriteLn('Unknown command line option: ', Arg);
Halt(1);
end;
procedure BadOption;
begin
WriteCopyright;
WriteLn('Invalid command line option: ', Arg);
Halt(1);
end;
procedure GetArgs(S : String);
var
SPos : Word;
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
if Arg = '?' then
WriteHelp
else
case Arg[1] of
'-', '/' :
case Length(Arg) of
1 : BadOption;
2 : case Upcase(Arg[2]) of
'?' : WriteHelp;
'C' : begin
CheckTSR := not CheckTSR;
if CheckTSR then begin
TSRName := StUpcase(NextArg(S, SPos));
if TSRName = '' then begin
WriteCopyright;
WriteLn('TSR name to check for is missing');
Halt(1);
end;
end;
end;
'E' : ShowEmsMem := not ShowEmsMem;
'F' : ShowFree := not ShowFree;
'H' : UseWatch := not UseWatch;
'L' : UseLoMem := not UseLoMem;
'Q' : Quiet := not Quiet;
'S' : ShowSummary := not ShowSummary;
'U' : UseHiMem := not UseHiMem;
'V' : Verbose := not Verbose;
'X' : ShowExtMem := not ShowExtMem;
else
BadOption;
end;
else
UnknownOption;
end;
else
UnknownOption;
end;
until False;
end;
begin
TsrName := '';
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('MAPMEM'));
{Account for related options}
if ShowFree then
ShowSummary := False;
if not UseLoMem then
UseHiMem := True;
if ShowFree or ShowSummary then begin
UseLoMem := True;
UseHiMem := True;
ShowEmsMem := True;
ShowExtMem := True;
Verbose := False;
end;
if not CheckTSR then
Quiet := False;
{Initialize for high memory access}
HiMemSeg := FindHiMemStart;
if HiMemSeg = 0 then
UseHiMem := False;
{Don't report any vectors normally taken over by SYSTEM}
SwapVectors;
{ExitProc will undo swap and restore high memory access}
SaveExit := ExitProc;
ExitProc := @SafeExit;
{Find WATCH in memory if requested}
if UseWatch then begin
WatchPsp := WatchPspSeg;
if WatchPsp = 0 then
UseWatch := False;
end;
if not Quiet then
WriteCopyright;
end;
begin
{$IFDEF MeasureStack}
FillChar(Mem[SSeg:0], SPtr-16, $AA);
{$ENDIF}
Initialize;
GetOptions;
if CheckTSR then
FindTSR
else begin
WriteLn;
ShowConventionalMem;
if ShowEmsMem then
ShowTheEmsMem;
if ShowExtMem then begin
ShowTheXmsMem;
ShowTheExtendedMem;
end;
end;
{$IFDEF MeasureStack}
I := 0;
while I < SPtr-16 do
if Mem[SSeg:i] <> $AA then begin
writeln('Unused stack ', i, ' bytes');
I := SPtr;
end else
inc(I);
{$ENDIF}
end.